;;;;
;;; Nehe Lesson #5 (Texture Mapping) and Lesson #12 (Display Lists)
;;; http://nehe.gamedev.net/data/lessons/lesson.asp?lesson=5
;;; http://nehe.gamedev.net/data/lessons/lesson.asp?lesson=12
;;; XMLisp version by John Miller, millejoh@mac.com, 12/29/10
;;; different from NEHE: separate rendering/animation; frame rate independent; different textures


(in-package :xlui)

;;;; Lesson #5, sort of.
;;; Using textures is trivial in XMLisp, but I present this example
;;; as it motivates a bit the next couple examples...

(defclass nehe-view (agent-3d-view)
  ()
  (:documentation "NEHE Lesson #5 - The Crate."))


(defmethod prepare-opengl  ((view nehe-view))
  ;; Back facing polygons are filled, while front facing are only outlined.
  ;; Apparently this is a setting of "personal preference" and the topic is more
  ;; fully discussedin the Red Book.
  (glShadeModel GL_SMOOTH)
  (glEnable GL_TEXTURE_2D)
  (glClearColor 0.0 0.0 0.0 0.5)
  (glClearDepth 1.0d0)
  (glEnable GL_DEPTH_TEST)
  (glDepthFunc GL_LEQUAL)
  (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST))

(defclass crate (agent-3d)
  ())

(defun gl-vertex (gl-vec)
  (glVertex3fv gl-vec))

(defmethod draw ((c crate))
  (let ((v0 {1.0 1.0 1.0})
        (v1 {-1.0 1.0 1.0})
        (v2 {-1.0 -1.0 1.0})
        (v3 {1.0 -1.0 1.0})
        (v4 {1.0 -1.0 -1.0})
        (v5 {1.0 1.0 -1.0})
        (v6 {-1.0 1.0 -1.0})
        (v7 {-1.0 -1.0 -1.0}))
    (use-texture c "crate.png")
    (glBegin GL_QUADS)
      ;; Front Face
      (glNormal3f 0.0 0.0 1.0)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v2)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v3)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v0)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v1)
      ;; Back Face
      (glNormal3f 0.0 0.0 -1.0)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v7)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v6)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v5)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v4)
      ;; Top Face
      (glNormal3f 0.0 1.0 0.0)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v6)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v1)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v0)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v5)
      ;; Bottom Face
      (glNormal3f 0.0 -1.0 0.0)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v4)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v7)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v2)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v3)
      ;; Right Face
      (glNormal3f 1.0 0.0 0.0)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v4)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v5)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v0)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v3)
      ;; Left Face
      (glNormal3f -1.0 0.0 0.0)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v2)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v1)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v6)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v7)
      (glEnd)))

(defclass qbert-view (agent-3d-view)
  ()
  (:documentation "NEHE Lesson 12: Display Lists"))

(defun draw-cube-body ()
  (let ((v0 {1.0 1.0 1.0})
        (v1 {-1.0 1.0 1.0})
        (v2 {-1.0 -1.0 1.0})
        (v3 {1.0 -1.0 1.0})
        (v4 {1.0 -1.0 -1.0})
        (v5 {1.0 1.0 -1.0})
        (v6 {-1.0 1.0 -1.0})
        (v7 {-1.0 -1.0 -1.0}))
    (glBegin GL_QUADS)
      ;; Front Face
      (glNormal3f 0.0 0.0 1.0)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v2)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v3)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v0)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v1)
      ;; Back Face
      (glNormal3f 0.0 0.0 -1.0)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v7)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v6)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v5)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v4)
      ;; Bottom Face
      (glNormal3f 0.0 -1.0 0.0)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v4)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v7)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v2)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v3)
      ;; Right Face
      (glNormal3f 1.0 0.0 0.0)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v4)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v5)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v0)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v3)
      ;; Left Face
      (glNormal3f -1.0 0.0 0.0)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v2)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v1)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v6)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v7)
      (glEnd)))

(defun draw-cube-top ()
  (let ((v0 {1.0 1.0 1.0})
        (v1 {-1.0 1.0 1.0})
        (v2 {-1.0 -1.0 1.0})
        (v3 {1.0 -1.0 1.0})
        (v4 {1.0 -1.0 -1.0})
        (v5 {1.0 1.0 -1.0})
        (v6 {-1.0 1.0 -1.0})
        (v7 {-1.0 -1.0 -1.0}))
      ;; Top Face
    (glBegin GL_QUADS)
    (glNormal3f 0.0 1.0 0.0)
    (glTexCoord2f 0.0 1.0)  (gl-vertex v6)
    (glTexCoord2f 0.0 0.0)  (gl-vertex v1)
    (glTexCoord2f 1.0 0.0)  (gl-vertex v0)
    (glTexCoord2f 1.0 1.0)  (gl-vertex v5)
    (glEnd)))


;;;; Lesson #12

(defclass qbert-pyramid (agent-3d)
  ())

(defparameter *box-colors* 
  (list {1.0 0.0 0.0} {1.0 0.5 0.0} {1.0 1.0 0.0} {0.0 1.0 0.0} {0.0 1.0 1.0}))

(defparameter *top-colors*
  (list {0.5 0.0 0.0} {0.5 0.25 0.0} {0.5 0.5 0.0} {0.0 0.5 0.0} {0.0 0.5 0.5}))

(defmethod rebuild-pyramid ((pyramid qbert-pyramid))
  (setf (agents pyramid) nil)
  (loop for yloop from 1 below 6
     do (dotimes (xloop yloop)
	     (let ((x (- (+ 1.4 (* xloop 2.8))
			 (* yloop 1.4)))
		   (y (- 6.0 (* yloop 2.4) 7.0))
		   (z -20.0)
		   (rx (- 45.0 (* 2.0 yloop)))
		   (ry 45.0))
	       (attach pyramid (make-instance 'qbert-cube :x x :y y :z z :heading ry
					   :body-color (nth (1- yloop) *box-colors*)
					   :top-color (nth (1- yloop) *top-colors*)))))))

(defmethod initialize-instance :after ((pyramid qbert-pyramid) &rest args)
  (declare (ignore args))
  (rebuild-pyramid pyramid))

(defmethod prepare-opengl  ((view qbert-view))
  ;; Back facing polygons are filled, while front facing are only outlined.
  ;; Apparently this is a setting of "personal preference" and the topic is more
  ;; fully discussedin the Red Book.
  (glShadeModel GL_SMOOTH)
  (glEnable GL_TEXTURE_2D)
  (glClearColor 0.0 0.0 0.0 0.5)
  (glClearDepth 1.0d0)
  (glEnable GL_DEPTH_TEST)
  (glDepthFunc GL_LEQUAL)
  (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST)
  (attach view (make-instance 'qbert-pyramid)))

(defclass qbert-cube (agent-3d)
  ((body-color :accessor body-color :initarg :body-color :initform {1.0 1.0 1.0})
   (top-color :accessor top-color :initarg :top-color :initform {1.0 1.0 1.0})
   (cube-dlist :accessor qbert-cube-dlist :initform 0)
   (cube-top-dlist :accessor qbert-cube-top-dlist :initform 0)))

(defparameter *compiled-dlists* (make-hash-table))

(defmacro with-named-dlist (name &body body)
  (let ((val (gensym))
	(presentp (gensym))
	(newlist (gensym)))
    `(multiple-value-bind (,val ,presentp) (gethash ,name *compiled-dlists*)
       (unless ,presentp
	 (let ((,newlist (glGenLists 1)))
	   (setf (gethash ,name *compiled-dlists*) ,newlist
		 ,val ,newlist)
	   (glNewList ,newlist GL_COMPILE)
	   ,@body
	   (glEndList)))
       (glCallList ,val))))

(defmethod draw ((cube qbert-cube))
  (glColor3fv (body-color cube))
  (with-named-dlist 'cube-body
    (draw-cube-body))
  (glColor3fv (top-color cube))
  (with-named-dlist 'cube-top
    (draw-cube-top)))


;;; A performance test with cubes and display lists


(defclass cube (agent-3d)
  ((color :accessor cube-color :initarg :color :initform {1.0 1.0 1.0 1.0})
   (texture :accessor cube-texture :initarg :texture :initform nil)))

(defun draw-cube ()
(let ((v0 {1.0 1.0 1.0})
        (v1 {-1.0 1.0 1.0})
        (v2 {-1.0 -1.0 1.0})
        (v3 {1.0 -1.0 1.0})
        (v4 {1.0 -1.0 -1.0})
        (v5 {1.0 1.0 -1.0})
        (v6 {-1.0 1.0 -1.0})
        (v7 {-1.0 -1.0 -1.0}))
    (glBegin GL_QUADS)
      ;; Front Face
      (glNormal3f 0.0 0.0 1.0)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v2)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v3)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v0)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v1)
      ;; Back Face
      (glNormal3f 0.0 0.0 -1.0)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v7)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v6)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v5)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v4)
      ;; Top Face
      (glNormal3f 0.0 1.0 0.0)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v6)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v1)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v0)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v5)
      ;; Bottom Face
      (glNormal3f 0.0 -1.0 0.0)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v4)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v7)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v2)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v3)
      ;; Right Face
      (glNormal3f 1.0 0.0 0.0)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v4)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v5)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v0)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v3)
      ;; Left Face
      (glNormal3f -1.0 0.0 0.0)
      (glTexCoord2f 0.0 0.0)         (gl-vertex v2)
      (glTexCoord2f 1.0 0.0)      (gl-vertex v1)
      (glTexCoord2f 1.0 1.0)  (gl-vertex v6)
      (glTexCoord2f 0.0 1.0)     (gl-vertex v7)
      (glEnd)))

(defmethod draw ((cube cube))
  (with-slots (color texture) cube
    (glColor4fv color)
  (when texture
    (use-texture cube texture))
  (with-named-dlist 'cube
    (draw-cube))))

;;;; The Examples

(defparameter *cube-example*

<application-window title="Nehe Lesson 6, Cubes and Textures" margin="0">
  <nehe-view name="cube">
    <camera eye-z="10.0"/>
    <crate/>
  </nehe-view>
</application-window>
)

(defparameter *qbert-example*
  <application-window title="Nehe Lesson 12, Display Lists" margin="0">
  <qbert-view name="qbert">
    <camera eye-z="10.0"/>
  </qbert-view>
</application-window>  
)